home *** CD-ROM | disk | FTP | other *** search
/ PCGUIA 127 / PC Guia 127.iso / Software / Utils / GParted Live CD / Bin / gparted-livecd-0.2.2.iso / usr_sqfs / bin / xpstat < prev    next >
Encoding:
Text File  |  2005-07-18  |  6.4 KB  |  271 lines
  1. #!/bin/sh
  2. # \
  3. exec expectk "$0" ${1+"$@"}
  4.  
  5. # This script acts as a front-end for xpilot.  Run it in the background,
  6. # and it will pop up a window for each server it finds running.  After
  7. # you run it, press the "?" button for more info.
  8.  
  9. # Store the filename of your xpilot client in the following variable.
  10. set xpilot /usr/local/bin/xpilot
  11.  
  12. # Author: Don Libes, NIST, 12/29/92
  13.  
  14. # I never have figured out how to get the alias out of xrdb.  For now, just
  15. # read it ourselves out of .Xdefaults - ugh.
  16.  
  17. log_user 0
  18.  
  19. set timeout 60
  20.  
  21. proc probe {} {
  22.     global max db hosts world
  23.  
  24.     set timeout -1
  25.  
  26.     expect_before eof {wait;return 0}
  27.  
  28.     expect -re "Server on (.*). Enter command> " {
  29.             exp_send "S\r"
  30.             set host $expect_out(1,string)
  31.             # replace dots in hostnames by underscores
  32.             regsub -all . $host _ host
  33.             # force lowercase to avoid Tk widget name problems
  34.             set host [string tolower $host]
  35.             lappend hosts $host
  36.     }
  37.     expect -re "WORLD\[^:]*: (\[^\r]*)\r" {
  38.         set worldtmp $expect_out(1,string)
  39.     }
  40.     expect -re "AUTHOR\[^:]*: (\[^\r]*)\r" {
  41.         set author $expect_out(1,string)
  42.     }
  43.     set world($host) "$worldtmp by $author"
  44.  
  45.     # skip over junk to get players
  46.     expect {
  47.         -re -+ {}
  48.         -re "Enter command> " {
  49.             set max($host) 0
  50.             display $host
  51.             return 1
  52.         }
  53.     }
  54.     set i 0
  55.     expect {
  56.         -re "\\.\\.\\. .  (................)   (...) *(\[^ ]*) *(\[^\r]*)\r" {
  57.             # strip trailing blanks
  58.             set alias [string trimright $expect_out(1,string)]
  59.             set db($host,$i,alias) $alias
  60.             
  61.             # strip leading zeros
  62.             scan $expect_out(2,string) %d db($host,$i,life)
  63.  
  64.             set db($host,$i,score) $expect_out(3,string)
  65.  
  66.             set db($host,name,$alias) $expect_out(4,string)
  67.  
  68.             incr i
  69.             exp_continue
  70.         }
  71.         -re "Enter command>"
  72.  
  73.     }
  74.     set max($host) $i
  75.     display $host
  76.  
  77.     return 1
  78. }
  79.  
  80. proc resize {w a b} {
  81.     # 27 is a guess at a fixed-width sufficiently comfortable for
  82.     # the variable-width font.  I don't know how to do better.
  83.     $w configure -width 27
  84. }
  85.  
  86. proc play {host} {
  87.     global xpilot alias
  88.  
  89.     exec xhost $host
  90.     catch {exec $xpilot -name $alias($host) -join $host} status
  91. }
  92.  
  93. proc show-help {x y msg} {
  94.     catch {destroy .help}
  95.     toplevel .help
  96.     wm geometry .help +$x+$y
  97.  
  98.     message .help.text -text $msg
  99.  
  100.     button .help.ok -text "ok" -command {destroy .help}
  101.     pack .help.text 
  102.     pack .help.ok -fill x
  103. }
  104.  
  105. # pop up window with alias
  106. proc show-alias {host seln x y} {
  107.     global db
  108.  
  109.     catch {destroy .alias}
  110.     toplevel .alias
  111.     wm geometry .alias +$x+$y
  112.     wm transient .alias .
  113.  
  114.     regexp "(.*\[^ ]) +\[-0-9]+ +\[0-9]+$" $seln discard alias
  115.  
  116.     button .alias.b -text "$db($host,name,$alias)" -command {
  117.         destroy .alias
  118.     }
  119.     .alias.b config -padx 1 -pady 1 -highlightthickness 0
  120.     pack .alias.b
  121. }
  122.  
  123. proc help {x y} {
  124.     show-help $x $y "xpstat - written by Don Libes, NIST, December 29, 1992
  125.  
  126. This script acts as a front-end for xpilot.  Run it in the background, and it will pop up a window for each server it finds running.  Press the \"?\" button for this info.
  127.  
  128. This program polls each xpilot server once a minute.  To make it poll immediately, press \"update\".  Press \"play as\" to enter the current game with the alias to the right.  Edit to taste.  (Your alias is initialized from the value of xpilot.name in ~/.Xdefaults.)
  129.  
  130. Double-click the left button on an alias to see the real user name.  To remove the user name window, click on it with the left button.
  131.  
  132. Pan the world/author text, player list, or your own alias by holding the middle mouse button down and moving the mouse."
  133. }
  134.  
  135. # if user presses "update" try to update screen immediately
  136. proc prod {x y} {
  137.     global cat_spawn_id updateflag
  138.  
  139.     if {$updateflag} {
  140.         show-help $x $y "I heard you, gimme a break.  I'm waiting for the xpilot server to respond..."
  141.     }
  142.     set updateflag 1
  143.  
  144.     exp_send -i $cat_spawn_id "\r"
  145. }
  146.  
  147. proc display {host} {
  148.     global world db alias max env
  149.  
  150.     set w .$host
  151.     if {![winfo exists $w]} {    
  152.  
  153.         # window does not exist, create it
  154.  
  155.         toplevel $w -class xpstat
  156.         wm minsize $w 1 1
  157.         wm title $w "xpilot@$host"
  158.         wm iconname $w "$host xpilot stats"
  159.         entry $w.world -state disabled -textvar world($host)
  160.  
  161.         listbox $w.players -yscroll "resize $w.players" -font 7x13bold
  162.         $w.players config -highlightthickness 0 -border 0
  163.         $w.world config -highlightthickness 0
  164.  
  165.         bind $w.players <Double-Button-1> {
  166.             scan %W ".%%\[^.]" host
  167.             show-alias $host [selection get] %X %Y
  168.         }
  169.  
  170.         message $w.msg -text "no players" -aspect 1000 -justify center
  171.  
  172.         button $w.help -text ? -command {
  173.             help 10 20
  174.         }
  175.  
  176.         button $w.update -text "update"
  177.         bind $w.update <1> {
  178.             after 1 prod %X %Y
  179.         }
  180.  
  181.         button $w.play -text "play as"
  182.         bind $w.play <1> {
  183.             scan %W ".%%\[^.]" host
  184.             after 1 play $host
  185.         }
  186.  
  187.         entry $w.alias -textvar alias($host) -width 10
  188.         set alias($host) $env(USER)
  189.  
  190.         bind $w.alias <Return> {
  191.             scan %W ".%%\[^.]" host
  192.             play $host
  193.         }
  194.  
  195.         $w.play config -padx 1 -pady 1 -highlightthickness 0
  196.         $w.update config -padx 1 -pady 1 -highlightthickness 0
  197.         $w.help config -padx 1 -pady 1 -highlightthickness 0
  198.         $w.alias config -highlightthickness 0
  199.  
  200.         pack $w.world -expand 1 -fill x
  201.         pack $w.msg
  202.         pack $w.help $w.update $w.play -side left
  203.         pack $w.alias -side left -expand 1 -fill x
  204.         set max($host,was) 0
  205.     }
  206.  
  207.     if {$max($host)==0} {
  208.         # put up "no players" message?
  209.         if {$max($host,was)>0} {
  210.             pack $w.msg -after $w.world -fill x -side top
  211.             pack forget $w.world
  212.         }
  213.     } else {
  214.         # remove "no players" message?
  215.         if {$max($host,was)==0} {
  216.             pack $w.players -after $w.world -side top
  217.             pack forget $w.msg
  218.         }
  219.     }        
  220.  
  221.     $w.players delete 0 end
  222.  
  223.     for {set i 0} {$i<$max($host)} {incr i} {
  224.         $w.players insert end [format "%-17s %4d %d" \
  225.             $db($host,$i,alias) \
  226.             $db($host,$i,score) \
  227.             $db($host,$i,life) \
  228.                     ]
  229.     }
  230.  
  231.     set max($host,was) $max($host)
  232. }
  233.  
  234. wm withdraw .
  235. set oldhosts {}
  236.  
  237. set updateflag 0        ;# 1 if user pressed "update" button
  238.  
  239. # look for desired alias in the .Xdefaults file
  240. set status [catch {exec egrep "xpilot.name:" [glob ~/.Xdefaults]} output]
  241. if {$status==0} {
  242.     regexp "xpilot.name:\[ \t]*(\[^\r]*)" $output dummy env(USER)
  243. }
  244.  
  245. spawn cat -u; set cat_spawn_id $spawn_id
  246.  
  247. while {1} {
  248.     global xpilot hosts
  249.  
  250.     set hosts {}
  251.  
  252.     eval spawn $xpilot $argv
  253.     while {[probe]} {exp_send "N\r"}
  254.     catch {expect_before}    ;# disable expect_before from inside probe
  255.  
  256.     # clean up hosts that no longer are running xpilots
  257.  
  258.     foreach host $oldhosts {
  259.         # if host not in hosts
  260.         if {-1==[lsearch $hosts $host]} {
  261.             destroy .$host
  262.         }
  263.     }
  264.     set oldhosts $hosts
  265.  
  266.     set updateflag 0
  267.  
  268.     # sleep for a little while, subject to click from "update" button
  269.     expect -i $cat_spawn_id -re "...."    ;# two crlfs
  270. }
  271.